Option Explicit

Private Const SCRIPT_TEMP_MODULE_NAME As String = "Script_Temp_Exec_Module"

' ======================================================================
' 导入 vba 组件
' ======================================================================
' 导入一个 vba 组件(Form, Module, Class) 到目标 Workbook
' @param wb 目标 Workbook
' @param componentCodeFilePath vba 组件(Form, Module, Class)代码文件的路径
Public Sub importVbaComponent(ByRef wb As Workbook, ByRef componentCodeFilePath As String)
    wb.VBProject.VBComponents.Import componentCodeFilePath
End Sub

' ======================================================================
' 添加 Module
' ======================================================================
' 添加一个 Module 到目标 Workbook，并写入 Module 的代码
' @param wb 目标 Workbook
' @param moduleName Module 名
' @param codeStr Module 代码
Public Sub addModuleByCodeStr(ByRef wb As Workbook, ByRef moduleName As String, ByRef codeStr As String)
On Error Goto catch:

    Dim component As VBComponent
    Set component = wb.VBProject.VBComponents.Add(vbext_ct_StdModule)
    With component
        .Name = moduleName
        .CodeModule.AddFromString codeStr
    End With

    Exit Sub

catch:
    Err.Raise Err.Number, Description:= "UtilsVBE#addModuleByCodeStr: Can not add Module. Module Name=" & moduleName & vbCrLf & _
        "origin error:" & vbCrLf & Err.Description
End Sub

' 添加一个 Module 到目标 Workbook，并写入文件中的内容
' VBA默认使用的是ANSI编码。如果是 UTF-8 编码的文件，则文件中的中文会乱码
' @param wb 目标 Workbook
' @param moduleName Module 名
' @param codeFilePath Module 代码文件路径
Public Sub addModuleByFile(ByRef wb As Workbook, ByRef moduleName As String, ByRef codeFilePath As String)
On Error Goto catch:

    Dim component As VBComponent
    Set component = wb.VBProject.VBComponents.Add(vbext_ct_StdModule)
    With component
        .Name = moduleName
        .CodeModule.AddFromFile codeFilePath
    End With

    Exit Sub

catch:
    Err.Raise Err.Number, Description:= "UtilsVBE#addModuleByFile: Can not add Module. Module Name=" & moduleName & vbCrLf & _
        "Code File Path=" & codeFilePath & vbCrLf & _
        "origin error:" & vbCrLf & Err.Description
End Sub

' 添加一个 Module 到目标 Workbook，并写入UTF8文件中的内容
' 使用该方法保存代码时，UTF-8编码文件中的中文不会乱码
' 
' @param wb 目标 Workbook
' @param moduleName Module 名
' @param codeFilePath Module 代码文件路径
Public Sub addModuleByUTF8File(ByRef wb As Workbook, ByRef moduleName As String, ByRef codeFilePath As String)
On Error Goto catch:

    Dim component As VBComponent
    Set component = wb.VBProject.VBComponents.Add(vbext_ct_StdModule)
    With component
        .Name = moduleName
        .CodeModule.AddFromString  UtilsIO.readFileWithUtf8(codeFilePath)
    End With

    Exit Sub

catch:
    Err.Raise Err.Number, Description:= "UtilsVBE#addModuleByUTF8File: Can not add Module. Module Name=" & moduleName & vbCrLf & _
        "Code File Path=" & codeFilePath & vbCrLf & _
        "origin error:" & vbCrLf & Err.Description
End Sub

' ======================================================================
' 添加 Class
' ======================================================================
' 添加一个 Class 到目标 Workbook，并写入 Class 的代码
' @param wb 目标 Workbook
' @param className Class 名
' @param codeStr Class 代码
Public Sub addClassByCodeStr(ByRef wb As Workbook, ByRef className As String, ByRef codeStr As String)
On Error Goto catch:

    Dim component As VBComponent
    Set component = wb.VBProject.VBComponents.Add(vbext_ct_ClassModule)
    With component
        .Name = className
        .CodeModule.AddFromString codeStr
    End With

    Exit Sub

catch:
    Err.Raise Err.Number, Description:= "UtilsVBE#addClassByCodeStr: Can not add Class. Class Name=" & className & vbCrLf & _
        "origin error:" & vbCrLf & Err.Description
End Sub

' 添加一个 Class 到目标 Workbook，并写入文件中的内容
' VBA默认使用的是ANSI编码。如果是 UTF-8 编码的文件，则文件中的中文会乱码
' 
' @param wb 目标 Workbook
' @param className Class 名
' @param codeFilePath Class 代码文件路径
Public Sub addClassByFile(ByRef wb As Workbook, ByRef className As String, ByRef codeFilePath As String)
On Error Goto catch:

    Dim component As VBComponent
    Set component = wb.VBProject.VBComponents.Add(vbext_ct_ClassModule)
    With component
        .Name = className
        .CodeModule.AddFromFile codeFilePath
    End With

    Exit Sub

catch:
    Err.Raise Err.Number, Description:= "UtilsVBE#addClassByFile: Can not add Class. Class Name=" & className & vbCrLf & _
        "Code File Path=" & codeFilePath & vbCrLf & _
        "origin error:" & vbCrLf & Err.Description
End Sub

' 添加一个 Class 到目标 Workbook，并写入UTF8文件中的内容
' 使用该方法保存代码时，UTF-8编码文件中的中文不会乱码
' 
' @param wb 目标 Workbook
' @param className Class 名
' @param codeFilePath Class 代码文件路径
Public Sub addClassByUTF8File(ByRef wb As Workbook, ByRef className As String, ByRef codeFilePath As String)
On Error Goto catch:

    Dim component As VBComponent
    Set component = wb.VBProject.VBComponents.Add(vbext_ct_ClassModule)
    With component
        .Name = className
        .CodeModule.AddFromString UtilsIO.readFileWithUtf8(codeFilePath)
    End With

    Exit Sub

catch:
    Err.Raise Err.Number, Description:= "UtilsVBE#addClassByUTF8File: Can not add Class. Class Name=" & className & vbCrLf & _
        "Code File Path=" & codeFilePath & vbCrLf & _
        "origin error:" & vbCrLf & Err.Description
End Sub

' ======================================================================
' 设置 ThisWorkbook 的代码
' ======================================================================
' 将代码字符串写入 ThisWorkbook
' @param wb 目标 Workbook
' @param codeStr Class 代码
Public Sub setThisWorkbookByCodeStr(ByRef wb As Workbook, ByRef codeStr As String)
    With wb.VBProject.VBComponents("ThisWorkbook")
        .CodeModule.AddFromString codeStr
    End With
End Sub

' 读取文件文件中的代码，并写入 ThisWorkbook
' VBA默认使用的是ANSI编码。如果是 UTF-8 编码的文件，则文件中的中文会乱码
' 
' @param wb 目标 Workbook
' @param codeFilePath Class 代码文件路径
Public Sub setThisWorkbookByFile(ByRef wb As Workbook, ByRef codeFilePath As String)
    With wb.VBProject.VBComponents("ThisWorkbook")
        .CodeModule.AddFromFile codeFilePath
    End With
End Sub

' 用 UTF-8 编码读取文件，并将文件中的代码写入 ThisWorkbook
' 使用该方法保存代码时，UTF-8编码文件中的中文不会乱码
' 
' @param wb 目标 Workbook
' @param codeFilePath Class 代码文件路径
Public Sub setThisWorkbookByUTF8File(ByRef wb As Workbook, ByRef codeFilePath As String)
    With wb.VBProject.VBComponents("ThisWorkbook")
        .CodeModule.AddFromString UtilsIO.readFileWithUtf8(codeFilePath)
    End With
End Sub

' ======================================================================
' form 操作
' ======================================================================
' 添加一个 Form 到目标 Workbook，并 codeStr 设置为 Form 的代码
' @param wb 目标 Workbook
' @param formName Form 名
' @param codeStr Form 代码
Public Sub addFormByCodeStr(ByRef wb As Workbook, ByRef formName As String, ByRef codeStr As String)
On Error Goto catch:

    Dim component As VBComponent
    Set component = wb.VBProject.VBComponents.Add(vbext_ct_MSForm)
    With component
        .Name = formName
        .CodeModule.AddFromString codeStr
    End With

    Exit Sub

catch:
    Err.Raise Err.Number, Description:= "UtilsVBE#addFormByCodeStr: Can not add Form. Form Name=" & formName & vbCrLf & _
        "origin error:" & vbCrLf & Err.Description
End Sub

' 添加一个 Form 到目标 Workbook，并写入文件中的内容设置为 Form 的代码
' VBA默认使用的是ANSI编码。如果是 UTF-8 编码的文件，则文件中的中文会乱码
' 
' @param wb 目标 Workbook
' @param formName Form 名
' @param codeFilePath Form 代码文件路径
Public Sub addFormByFile(ByRef wb As Workbook, ByRef formName As String, ByRef codeFilePath As String)
On Error Goto catch:

    Dim component As VBComponent
    Set component = wb.VBProject.VBComponents.Add(vbext_ct_ClassModule)
    With component
        .Name = formName
        .CodeModule.AddFromFile codeFilePath
    End With

    Exit Sub

catch:
    Err.Raise Err.Number, Description:= "UtilsVBE#addFormByFile: Can not add Form. Form Name=" & formName & vbCrLf & _
        "Code File Path=" & codeFilePath & vbCrLf & _
        "origin error:" & vbCrLf & Err.Description
End Sub

' 添加一个 Form 到目标 Workbook，并将UTF8文件中的内容设置为 Form 的代码
' 使用该方法保存代码时，UTF-8编码文件中的中文不会乱码
' 
' @param wb 目标 Workbook
' @param formName Form 控件名
' @param codeFilePath Form 代码文件路径
Public Sub addFormByUTF8File(ByRef wb As Workbook, ByRef formName As String, ByRef codeFilePath As String)
On Error Goto catch:
    Dim component As VBComponent
    Set component = wb.VBProject.VBComponents.Add(vbext_ct_MSForm)
    With component
        .Name = formName
        .CodeModule.AddFromString UtilsIO.readFileWithUtf8(codeFilePath)
    End With

    Exit Sub

catch:
    Err.Raise Err.Number, Description:= "UtilsVBE#addFormByFile: Can not add Form. Form Name=" & formName & vbCrLf & _
        "Code File Path=" & codeFilePath & vbCrLf & _
        "origin error:" & vbCrLf & Err.Description
End Sub

' ======================================================================
' 导入资源
' ======================================================================
' 将一个组件的文件 `srcFilePath` 到目标 wb
' UTF-8编码文件中的中文会乱码
'
' @param wb 目标 Workbook
' @param srcFilePath 组件文件的路径
Public Sub import(ByRef wb As Workbook, ByRef srcFilePath As String)
    wb.VBProject.VBComponents.Import srcFilePath
End Sub

' ======================================================================
' 检查操作
' ======================================================================
' 检查一个 workbook 中是否存在某个名称的组件
' @param wb 需要执行代码片段的 Workbook
' @param componentName 组件名称
Public Function hasComponent(ByRef wb As Workbook, ByRef componentName As String) As Boolean
On Error Goto catch:
    ' 尝试通过组件名来获取组件，如果成功就是：组件存在。如果发生异常，就不存在
    wb.VBProject.VBComponents.Item(componentName)
    hasComponent = True
    Exit Function
catch:
    hasComponent = False
    Err.Clear
End Function

' ======================================================================
' 删除操作
' ======================================================================
' 从指定的 book 中删除一个组件
' @param wb 需要删除组件的 Workbook
' @param componentName 组件名称
Public Sub deleteComponent(ByRef wb As Workbook, ByRef componentName As String)
    ' 1. 如果组件不存在，则结束
    If hasComponent(wb, componentName) = False Then
        Exit Sub
    End If

    wb.VBProject.VBComponents.Remove wb.VBProject.VBComponents.Item(componentName)
End Sub

' ======================================================================
' 其他
' ======================================================================
' 导入一个代码片段文件中的代码，并通过入口方法来执行代码片段。执行完成后会删除片段
' UTF-8编码文件中的中文不会乱码
'
' @param wb 需要执行代码片段的 Workbook  
' @param srcFilePath 组件文件的路径 
' @optional-param execFuncName 运行代码片段的入口方法。默认值=`main`
' @optional-param ignoreRuntimeError 是否忽略运行时异常。默认值=`True`
' @optional-param execFuncName 运行代码片段的入口方法。默认值=`main`  
Public Sub execScript(ByRef wb As Workbook, ByRef scriptFilePath As String, _
    Optional ByRef execFuncName As String = "main", Optional ByRef ignoreRuntimeError As Boolean = True)
    ' 1. 删除组件: SCRIPT_TEMP_MODULE_NAME
    deleteComponent wb, SCRIPT_TEMP_MODULE_NAME

    ' 2. 创建临时 Module，并导入代码
    addModuleByUTF8File wb, SCRIPT_TEMP_MODULE_NAME, scriptFilePath

    ' 3. 通过代码入口来执行代码片段
On Error Goto catch:
    If execFuncName = "" Then
        wb.Application.Run "'" & wb.FullName & "'!" & SCRIPT_TEMP_MODULE_NAME & ".main"
    Else
        wb.Application.Run "'" & wb.FullName & "'!" & SCRIPT_TEMP_MODULE_NAME & "." & execFuncName
    End If

    ' 4. 删除临时 Module
    deleteComponent wb, SCRIPT_TEMP_MODULE_NAME

    Exit Sub
catch:

    If ignoreRuntimeError Then
        deleteComponent wb, SCRIPT_TEMP_MODULE_NAME
        ' 发生执行异常时，清空异常
        Err.Clear
    Else
        Err.Raise Err.Number, Description:=Err.Description
        deleteComponent wb, SCRIPT_TEMP_MODULE_NAME
    End If

End Sub

' ======================================================================
' 引用操作
' ======================================================================
' 向一个 workbook 中添加引用
' @param wb 需要添加引用的 Workbook
' @param filePath 引用的文件路径
' @return Boolean 引用是否添加成功
Public Function addRefByFile(ByRef wb As Workbook, ByRef filePath As String) As Boolean
On Error Goto catch:
    wb.VBProject.References.AddFromFile filePath
    addRefByFile = True
    Exit Function
catch:
    Err.Clear
    addRefByFile = False
End Function

' 向一个 workbook 中添加引用
' @param wb 需要添加引用的 Workbook
' @param refName 引用的名称
' @return Boolean 引用是否删除成功
Public Function removeRef(ByRef wb As Workbook, ByRef refName As String) As Boolean
On Error Goto catch:
    wb.VBProject.References.Remove wb.VBProject.References(refName)
    removeRef = True
    Exit Function
catch:
    Err.Clear
    removeRef = False
End Function

' 向一个 workbook 中添加引用: `Microsoft Visual Basic for Applications Extensibility 5.3`
' @param wb 需要添加引用的 Workbook
' @return Boolean 引用是否删除成功
Public Function addRefVBIDE53(ByRef wb As Workbook) As Boolean
    addRefByFile wb, "C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
End Function

' 从一个 workbook 中删除引用: `Microsoft Visual Basic for Applications Extensibility 5.3`
' @param wb 需要删除引用的 Workbook
' @return Boolean 引用是否删除成功
Public Function removeRefVBIDE53(ByRef wb As Workbook) As Boolean
    removeRef wb, "VBIDE"
End Function

' ======================================================================
' 拷贝操作
' ======================================================================
' 从 `srcWb` 中拷贝指定名称的 module 到 `descWb` 中
'
' @param srcWb 源 Workbook
' @param moduleName Module 名
' @param descWb 目标 Workbook
Public Sub copyWbModule( _
    ByRef srcWb As Workbook, _
    ByRef moduleName As String, _
    ByRef descWb As Workbook)

    Dim targetModule As VBComponent

    ' 1. 检查 module 是否存在
    On Error Resume Next
    Set targetModule = srcWb.VBProject.VBComponents(moduleName)
    On Error GoTo 0

    If targetModule Is Nothing Then
        Err.Raise Err.Number, Description:= "UtilsVBE#copyWbModule: Can not copy Module. Module Name=" & moduleName & vbCrLf & _
            "Code File Path=" & srcWb.FullName & vbCrLf & _
            "origin error:" & vbCrLf & Err.Description
        Exit Sub
    End If

    ' 2. 导入目标 module 到临时路径
    Dim tempFilePath As String
    '    构造临时文件路径（用于导出模块）
    tempFilePath = Environ("TEMP") & "\" & moduleName & ".bas"

    ' 导出模块到临时文件
    targetModule.Export tempFilePath

    ' 3. 导入模块到目标 workbook
    descWb.VBProject.VBComponents.Import tempFilePath

    ' 删除临时文件
    Kill tempFilePath

' 从 `srcWb` 中拷贝指定名称的 class 到 `descWb` 中
'
' @param srcWb 源 Workbook
' @param moduleName Class 名
' @param descWb 目标 Workbook
Public Sub copyWbClass( _
    ByRef srcWb As Workbook, _
    ByRef className As String, _
    ByRef descWb As Workbook)

    Dim targetModule As VBComponent

    ' 1. 检查 class 是否存在
    On Error Resume Next
    Set targetModule = srcWb.VBProject.VBComponents(className)
    On Error GoTo 0

    If targetModule Is Nothing Then
        Err.Raise Err.Number, Description:= "UtilsVBE#copyWbClass: Can not copy Class. Class Name=" & className & vbCrLf & _
            "Code File Path=" & srcWb.FullName & vbCrLf & _
            "origin error:" & vbCrLf & Err.Description
        Exit Sub
    End If

    ' 2. 导入目标 class 到临时路径
    Dim tempFilePath As String
    '    构造临时文件路径（用于导出模块）
    tempFilePath = Environ("TEMP") & "\" & className & ".cls"

    ' 导出模块到临时文件
    targetModule.Export tempFilePath

    ' 3. 导入模块到目标 workbook
    descWb.VBProject.VBComponents.Import tempFilePath

    ' 删除临时文件
    Kill tempFilePath
End Sub